Source: https://github.com/markziemann/cryptoblog/blob/main/ma_trading.Rmd
This report is distributed for FREE under the MIT licence, but if you find it useful, consider a small tip.
XMR:4BGrdeAF5qyJQXjzWF4W5uCZF7WuwJU16BfPtgg1WJMnf33jZMtLvoF1jRtZBGpLtz5BQZaLYiBFJJC488anty64FB7SASD
Intro
Keltner Channels are volatility-based envelopes set above and below a moving average. This indicator is similar to Bollinger Bands, but Keltner Channels use the Average True Range (ATR) to set channel distance. Keltner Channels are a trend following indicator, and can also be used to identify overbought and oversold levels when there is no trend.
Chester Keltner is credited with the original version of Keltner Channels in his 1960 book. Linda Bradford Raschke introduced the newer version of Keltner Channels in the 1980s.
This page is designed to be updated daily - today’s date is shown below.
suppressPackageStartupMessages({
library("jsonlite")
library("tidyverse")
library("runner")
library("quantmod")
library("TTR")
library("vioplot")
library("kableExtra")
})
Sys.Date()## [1] "2022-07-02"Reminder: this is not financial advice.
Keltner channel indicator
Thanks to Nick Procyk for providing the KC indicator code to TTR.
KC <-
function (HLC, n = 20, maType, atr = 2, ...)
{
atrHLC <- HLC
HLC <- try.xts(HLC, error = as.matrix)
if (NCOL(HLC) == 3) {
if (is.xts(HLC)) {
xa <- xcoredata(HLC)
HLC <- xts(apply(HLC, 1, mean), index(HLC))
xcoredata(HLC) <- xa
}
else {
HLC <- apply(HLC, 1, mean)
}
}
else if (NCOL(HLC) != 1) {
stop("Price series must be either High-Low-Close, or Close/univariate.")
}
maArgs <- list(n = n, ...)
if (missing(maType)) {
maType <- "EMA"
}
mavg <- do.call(maType, c(list(HLC), maArgs))
avgtruerange <- ATR(atrHLC, n = n)
up <- mavg + atr * avgtruerange[,2]
dn <- mavg - atr * avgtruerange[,2]
res <- cbind(dn, mavg, up)
colnames(res) <- c("dn", "mavg", "up")
reclass(res, HLC)
}
#KChannels(HLC, n = 20, maType, atr = 2, ...)HLC Object that is coercible to xts or matrix and contains High-Low-Close prices. If only a univariate series is given, it will be used. See details.
n Number of periods for moving average.
maType A function or a string naming the function to be called.
atr The number of average true range distances to apply.
… Other arguments to be passed to the maType function.
Weekly KC for BTC
mydate <- Sys.Date()-1
URL=paste("https://web-api.coinmarketcap.com/v1/cryptocurrency/ohlcv/historical?symbol=BTC&convert=USD&interval=weekly&time_start=2013-06-01&time_end=",mydate,sep="")
download.file(URL,destfile="btcdat.txt")
dat <- fromJSON("btcdat.txt")
price <- dat$data$quotes
price <- data.frame(price$time_close, price$quote$USD$high,
price$quote$USD$low, price$quote$USD$close,stringsAsFactors=FALSE)
colnames(price) <- c("date","high","low","close")
price$date <- sapply(strsplit(as.character(price$date),"T"),"[[",1)10 week KC.
kc <- KC(HLC(price), n = 10, maType=SMA, atr = 2)
plot(price$close~as.Date(price$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=10wk")
grid()
lines(as.Date(price$date) , kc[,"dn"] ,col="red")
lines(as.Date(price$date) , kc[,"mavg"] , col="red")
lines(as.Date(price$date) , kc[,"up"] , col="red")
price2 <- tail(price,200)
kc2 <- tail(kc,200)
plot(price2$close~as.Date(price2$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=10wk")
grid()
lines(as.Date(price2$date) , kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) , kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) , kc2[,"up"] , col="red")
20 week KC.
kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)
plot(price$close~as.Date(price$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=20wk")
grid()
lines(as.Date(price$date) , kc[,"dn"] ,col="red")
lines(as.Date(price$date) , kc[,"mavg"] , col="red")
lines(as.Date(price$date) , kc[,"up"] , col="red")
price2 <- tail(price,200)
kc2 <- tail(kc,200)
plot(price2$close~as.Date(price2$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=20wk")
grid()
lines(as.Date(price2$date) , kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) , kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) , kc2[,"up"] , col="red")
Daily KC for BTC
Obtaining BTC historical data (daily) from CoinMarketCap.com from June 2013 to present.
mydate <- Sys.Date()-1
URL=paste("https://web-api.coinmarketcap.com/v1/cryptocurrency/ohlcv/historical?symbol=BTC&convert=USD&interval=daily&time_start=2013-06-01&time_end=",mydate,sep="")
download.file(URL,destfile="btcdat.txt")
dat <- fromJSON("btcdat.txt")
price <- dat$data$quotes
price <- data.frame(price$time_close, price$quote$USD$high,
price$quote$USD$low, price$quote$USD$close,stringsAsFactors=FALSE)
colnames(price) <- c("date","high","low","close")
price$date <- sapply(strsplit(as.character(price$date),"T"),"[[",1)kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)
plot(price$close~as.Date(price$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=20d")
grid()
lines(as.Date(price$date) , kc[,"dn"] ,col="red")
lines(as.Date(price$date) , kc[,"mavg"] , col="red")
lines(as.Date(price$date) , kc[,"up"] , col="red")
kc <- KC(HLC(price), n = 43, maType=SMA, atr = 2)
plot(price$close~as.Date(price$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=43d")
grid()
lines(as.Date(price$date) , kc[,"dn"] ,col="red")
lines(as.Date(price$date) , kc[,"mavg"] , col="red")
lines(as.Date(price$date) , kc[,"up"] , col="red")
kc <- KC(HLC(price), n = 72, maType=SMA, atr = 2)
plot(price$close~as.Date(price$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=72d")
grid()
lines(as.Date(price$date) , kc[,"dn"] ,col="red")
lines(as.Date(price$date) , kc[,"mavg"] , col="red")
lines(as.Date(price$date) , kc[,"up"] , col="red")
KC BTC daily recent action
kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)
price2 <- tail(price,200)
kc2 <- tail(kc,200)
plot(price2$close~as.Date(price2$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=20d")
grid()
lines(as.Date(price2$date) , kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) , kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) , kc2[,"up"] , col="red")
Weekly KC for ETH
mydate <- Sys.Date()-1
URL=paste("https://web-api.coinmarketcap.com/v1/cryptocurrency/ohlcv/historical?symbol=ETH&convert=USD&interval=weekly&time_start=2013-06-01&time_end=",mydate,sep="")
download.file(URL,destfile="ethdat.txt")
dat <- fromJSON("ethdat.txt")
price <- dat$data$quotes
price <- data.frame(price$time_close, price$quote$USD$high,
price$quote$USD$low, price$quote$USD$close,stringsAsFactors=FALSE)
colnames(price) <- c("date","high","low","close")
price$date <- sapply(strsplit(as.character(price$date),"T"),"[[",1)10 week KC.
kc <- KC(HLC(price), n = 10, maType=SMA, atr = 2)
plot(price$close~as.Date(price$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=10wk")
grid()
lines(as.Date(price$date) , kc[,"dn"] ,col="red")
lines(as.Date(price$date) , kc[,"mavg"] , col="red")
lines(as.Date(price$date) , kc[,"up"] , col="red")
price2 <- tail(price,200)
kc2 <- tail(kc,200)
plot(price2$close~as.Date(price2$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=10wk")
grid()
lines(as.Date(price2$date) , kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) , kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) , kc2[,"up"] , col="red")
20 week KC.
kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)
plot(price$close~as.Date(price$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=20wk")
grid()
lines(as.Date(price$date) , kc[,"dn"] ,col="red")
lines(as.Date(price$date) , kc[,"mavg"] , col="red")
lines(as.Date(price$date) , kc[,"up"] , col="red")
price2 <- tail(price,200)
kc2 <- tail(kc,200)
plot(price2$close~as.Date(price2$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=20wk")
grid()
lines(as.Date(price2$date) , kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) , kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) , kc2[,"up"] , col="red")
Daily KC for ETH
Obtaining ETH historical data (daily) from CoinMarketCap.com from 2015 to present.
mydate <- Sys.Date()-1
URL=paste("https://web-api.coinmarketcap.com/v1/cryptocurrency/ohlcv/historical?symbol=ETH&convert=USD&interval=daily&time_start=2013-06-01&time_end=",mydate,sep="")
download.file(URL,destfile="ethdat.txt")
dat <- fromJSON("ethdat.txt")
price <- dat$data$quotes
price <- data.frame(price$time_close, price$quote$USD$high,
price$quote$USD$low, price$quote$USD$close,stringsAsFactors=FALSE)
colnames(price) <- c("date","high","low","close")
price$date <- sapply(strsplit(as.character(price$date),"T"),"[[",1)kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)
plot(price$close~as.Date(price$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=20d")
grid()
lines(as.Date(price$date) , kc[,"dn"] ,col="red")
lines(as.Date(price$date) , kc[,"mavg"] , col="red")
lines(as.Date(price$date) , kc[,"up"] , col="red")
kc <- KC(HLC(price), n = 43, maType=SMA, atr = 2)
plot(price$close~as.Date(price$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=43d")
grid()
lines(as.Date(price$date) , kc[,"dn"] ,col="red")
lines(as.Date(price$date) , kc[,"mavg"] , col="red")
lines(as.Date(price$date) , kc[,"up"] , col="red")
kc <- KC(HLC(price), n = 72, maType=SMA, atr = 2)
plot(price$close~as.Date(price$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=72d")
grid()
lines(as.Date(price$date) , kc[,"dn"] ,col="red")
lines(as.Date(price$date) , kc[,"mavg"] , col="red")
lines(as.Date(price$date) , kc[,"up"] , col="red")
KC ETH daily recent action
kc <- KC(HLC(price), n = 20, maType=SMA, atr = 2)
price2 <- tail(price,200)
kc2 <- tail(kc,200)
plot(price2$close~as.Date(price2$date),type="l",log="y",
xlab="Date",ylab="price (USD)",main="Keltner Channels n=20d")
grid()
lines(as.Date(price2$date) , kc2[,"dn"] ,col="red")
lines(as.Date(price2$date) , kc2[,"mavg"] , col="red")
lines(as.Date(price2$date) , kc2[,"up"] , col="red")
Session information
For reproducibility
sessionInfo()## R version 4.1.2 (2021-11-01)
## Platform: aarch64-unknown-linux-gnu (64-bit)
## Running under: Ubuntu 22.04 LTS
##
## Matrix products: default
## BLAS: /usr/lib/aarch64-linux-gnu/blas/libblas.so.3.10.0
## LAPACK: /usr/lib/aarch64-linux-gnu/lapack/liblapack.so.3.10.0
##
## locale:
## [1] LC_CTYPE=en_AU.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_AU.UTF-8 LC_COLLATE=en_AU.UTF-8
## [5] LC_MONETARY=en_AU.UTF-8 LC_MESSAGES=en_AU.UTF-8
## [7] LC_PAPER=en_AU.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=en_AU.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] kableExtra_1.3.4 vioplot_0.3.7 sm_2.2-5.7 quantmod_0.4.20
## [5] TTR_0.24.3 xts_0.12.1 zoo_1.8-10 runner_0.4.1
## [9] forcats_0.5.1 stringr_1.4.0 dplyr_1.0.9 purrr_0.3.4
## [13] readr_2.1.2 tidyr_1.2.0 tibble_3.1.7 ggplot2_3.3.6
## [17] tidyverse_1.3.1 jsonlite_1.8.0
##
## loaded via a namespace (and not attached):
## [1] Rcpp_1.0.8.3 svglite_2.1.0 lubridate_1.8.0 lattice_0.20-45
## [5] assertthat_0.2.1 digest_0.6.29 utf8_1.2.2 R6_2.5.1
## [9] cellranger_1.1.0 backports_1.4.1 reprex_2.0.1 evaluate_0.15
## [13] highr_0.9 httr_1.4.3 pillar_1.7.0 rlang_1.0.2
## [17] curl_4.3.2 readxl_1.4.0 rstudioapi_0.13 jquerylib_0.1.4
## [21] rmarkdown_2.14 webshot_0.5.3 munsell_0.5.0 broom_0.8.0
## [25] compiler_4.1.2 modelr_0.1.8 xfun_0.30 systemfonts_1.0.4
## [29] pkgconfig_2.0.3 htmltools_0.5.2 tidyselect_1.1.2 viridisLite_0.4.0
## [33] fansi_1.0.3 crayon_1.5.1 tzdb_0.3.0 dbplyr_2.1.1
## [37] withr_2.5.0 grid_4.1.2 gtable_0.3.0 lifecycle_1.0.1
## [41] DBI_1.1.2 magrittr_2.0.3 scales_1.2.0 cli_3.3.0
## [45] stringi_1.7.6 fs_1.5.2 xml2_1.3.3 bslib_0.3.1
## [49] ellipsis_0.3.2 generics_0.1.2 vctrs_0.4.1 tools_4.1.2
## [53] glue_1.6.2 hms_1.1.1 parallel_4.1.2 fastmap_1.1.0
## [57] yaml_2.3.5 colorspace_2.0-3 rvest_1.0.2 knitr_1.39
## [61] haven_2.5.0 sass_0.4.1